home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.06.lha / AmiCAD / ARexx / grille.AmiCAD < prev    next >
Text File  |  2000-04-13  |  5KB  |  194 lines
  1. /* Création d'une grille quadrillée
  2. $VER: Grille.AmiCAD 1.05 (© R.Florac, 13/04/00)
  3. Version 1.00 ©R.Florac, Mardi 3 Mars 1998
  4. Version 1.01, 25 avril 1998 (utilisation d'un rectangle pour définir la zone recevant la grille)
  5. Version 1.02, 12 novembre 1998 (correction bug variables x0 et y0)
  6. Version 1.03, 29 Mars 1999 (ajout GETZONE)
  7. Version 1.04, 22 Mai 1999 (Modification DRAWMODE)
  8. Version 1.05, 13 avril 2000 (Adaptation version 2.05) */
  9.  
  10. options results     /* indispensable pour récupérer le résultat des macros */
  11.  
  12. signal on error     /* pour l'interception des erreurs */
  13. signal on syntax
  14.  
  15. 'WWIDTH'; lt = result
  16. 'WHEIGHT'; ht=result
  17. clip=-1
  18. FIRSTSEL; obj=result
  19. if obj>0 then do
  20.     'TYPE(FIRSTSEL)'; type=result
  21.     if type=22 then do
  22.     'CLIPUNIT(5)'; clip=result
  23.     'COORDS(FIRSTSEL)'; coords=result
  24.     PARSE VAR coords x0 ',' y0 ',' x1 ',' y1
  25.     xg=minima(x0,x1); xd=maxima(x0,x1)
  26.     yh=minima(y0,y1); yb=maxima(y0,y1)
  27.     l=xd-xg+1; h=yb-yh+1
  28.     'NEXTSEL('obj')'; obj=result
  29.     end
  30. end
  31. else obj=1
  32.  
  33. if obj>0 then do
  34.     'GETZONE("Dessinez un rectangle avec la souris")'
  35.     coords=result
  36.     if coords="" then call quitter
  37.     PARSE VAR coords x0 ',' y0 ',' x1 ',' y1
  38.     xg=minima(x0,x1); xd=maxima(x0,x1)
  39.     yh=minima(y0,y1); yb=maxima(y0,y1)
  40.     l=xd-xg+1; h=yb-yh+1
  41. end
  42.  
  43. 'ASKNUM("Axe horizontal"+CHR(10)+"Nombre de décades?",1)'
  44. ndh = result
  45. if ndh<=0 then call quitter
  46. 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
  47. tt=result
  48. x0=xg; y0=yh; y1=yh+h; x1=xg+ndh*(l%ndh)    /* Version 1.02 */
  49.  
  50. 'SAVEALL'
  51. if clip>=0 then 'MENU("Cut")'
  52. /* Tracé des lignes verticales */
  53. select
  54.     when tt=1 then do
  55.     /* Tracé des lignes verticales */
  56.     do i=1 to ndh
  57.         x2 = (x0)+i*(l/ndh)
  58.         x2 = x2%1
  59.         'DRAWMODE(-1)'
  60.         do c=1 to 9
  61.         xc = x2-(l/ndh)/10*c
  62.         xc=xc%1
  63.         'DRAW('xc','y0','xc','y1')'
  64.         end
  65.         'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
  66.     end
  67.     end
  68.     when tt=2 then do
  69.     if ~show('L','rexxmathlib.library') then
  70.        call addlib('rexxmathlib.library',0,-30)
  71.     /* Tracé des lignes verticales */
  72.     x2=x0
  73.     do i=1 to ndh
  74.         'DRAWMODE(-1)'
  75.         do c=2 to 9
  76.         xc=(l/ndh)*log10(c)
  77.         xc=(x2+xc)%1
  78.         'DRAW('xc','y0','xc','y1')'
  79.         end
  80.         x2 = (x0)+i*(l/ndh)
  81.         x2 = x2%1
  82.         'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
  83.     end
  84.     end
  85.     when tt=3 then do
  86.     if ~show('L','rexxmathlib.library') then
  87.        call addlib('rexxmathlib.library',0,-30)
  88.     x2=x1
  89.     do i=1 to ndh
  90.         'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
  91.         'DRAWMODE(-1)'
  92.         do c=2 to 9
  93.         xc=(l/ndh)*log10(c)
  94.         xc=(x2-xc)%1
  95.         'DRAW('xc','y0','xc','y1')'
  96.         end
  97.         x2 = (x1)-i*(l/ndh)
  98.         x2 = x2%1
  99.     end
  100.     end
  101.     otherwise call quitter
  102. end
  103.  
  104. 'ASKNUM("Axe vertical"+CHR(10)+"Nombre de décades?",1)'
  105. ndv = result
  106. if ndv<=0 then call quitter
  107.  
  108. y1=y0+h
  109. x1=x0+ndh*(l%ndh)
  110. /* Tracé du contour */
  111. 'DRAWMODE(-2):DRAW('x0','y0','x1','y0'):DRAW('x0','y1','x0','y0')'
  112.  
  113. 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
  114. tt=result
  115.  
  116. /* Tracé des lignes horizontales */
  117. select
  118.     when tt=1 then do
  119.     do i=1 to ndv
  120.         y2 = (y0)+i*(h/ndv)
  121.         y2 = y2%1
  122.         'DRAWMODE(-1)'
  123.         do c=1 to 9
  124.         yc = y2-(h/ndv)/10*c
  125.         yc=yc%1
  126.         'DRAW('x0','yc','x1','yc')'
  127.         end
  128.         'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
  129.     end
  130.     end
  131.     when tt=2 then do
  132.     if ~show('L','rexxmathlib.library') then
  133.        call addlib('rexxmathlib.library',0,-30)
  134.     y2=y1
  135.     do i=1 to ndv
  136.         'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
  137.         'DRAWMODE(-1)'
  138.         do c=2 to 9
  139.         yc=(h/ndv)*log10(c)
  140.         yc=(y2-yc)%1
  141.         'DRAW('x0','yc','x1','yc')'
  142.         end
  143.         y2 = y1-i*(h/ndv)
  144.         y2 = y2%1
  145.     end
  146.     end
  147.     when tt=3 then do
  148.     if ~show('L','rexxmathlib.library') then
  149.        call addlib('rexxmathlib.library',0,-30)
  150.  
  151.     y2=y0
  152.  
  153.     do i=1 to ndv
  154.         'DRAWMODE(-1)'
  155.         do c=2 to 9
  156.         yc=(h/ndv)*log10(c)
  157.         yc=(y2+yc)%1
  158.         'DRAW('x0','yc','x1','yc')'
  159.         end
  160.         y2 = (y0)+i*(h/ndv)
  161.         y2 = y2%1
  162.         'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
  163.     end
  164.     end
  165.     otherwise call quitter
  166. end
  167. call quitter
  168.  
  169. minima: procedure
  170.     parse arg v1,v2
  171.     if v1<v2 then return v1
  172.     return v2
  173. end
  174.  
  175. maxima: procedure
  176.     parse arg v1,v2
  177.     if v1>v2 then return v1
  178.     return v2
  179. end
  180.  
  181. quitter: procedure expose clip
  182.     if clip>=0 then 'CLIPUNIT('clip')'
  183.     exit
  184.  
  185. /* Traitement des erreurs, interruption du programme */
  186. syntax:
  187. erreur=RC
  188. 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  189. call quitter
  190.  
  191. error:
  192. 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
  193. call quitter
  194.